home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue30 / startup / TBLTESTU.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1997-12-01  |  2.7 KB  |  109 lines
  1. unit TblTestU;
  2.  
  3. interface
  4.  
  5. uses
  6.   WinProcs, WinTypes, Messages, SysUtils, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Menus, ExtCtrls;
  8.  
  9. type
  10.   TMainForm = class(TForm)
  11.     lstDataFields: TListBox;
  12.     lstMethods: TListBox;
  13.     Label1: TLabel;
  14.     Label2: TLabel;
  15.     Bevel1: TBevel;
  16.     MainMenu1: TMainMenu;
  17.     File1: TMenuItem;
  18.     Exit1: TMenuItem;
  19.     procedure FormCreate(Sender: TObject);
  20.     procedure ListBoxMouseMove(Sender: TObject;
  21.       Shift: TShiftState; X, Y: Integer);
  22.     procedure Exit1Click(Sender: TObject);
  23.     procedure lstDataFieldsDblClick(Sender: TObject);
  24.     procedure lstMethodsDblClick(Sender: TObject);
  25.   private
  26.     { Private declarations }
  27.   public
  28.     { Public declarations }
  29.   end;
  30.  
  31. var
  32.   MainForm: TMainForm;
  33.  
  34. implementation
  35.  
  36. uses TblInfo;
  37.  
  38. {$R *.DFM}
  39.  
  40. procedure TMainForm.FormCreate(Sender: TObject);
  41. begin
  42.   GetMethodNames(Self.ClassType, lstMethods.Items);
  43.   GetDataFieldNames(Self.ClassType, lstDataFields.Items);
  44.   lstDataFields.Perform(lb_SetHorizontalExtent, 250, 0);
  45.   lstMethods.Perform(lb_SetHorizontalExtent, 300, 0);
  46. end;
  47.  
  48. procedure TMainForm.ListBoxMouseMove(Sender: TObject;
  49.   Shift: TShiftState; X, Y: Integer);
  50. begin
  51. {$ifdef Win32}
  52.   with (Sender as TListBox) do
  53.   begin
  54.     ShowHint := False;
  55.     Application.ProcessMessages;
  56.     ItemIndex := Perform(lb_ItemFromPoint, 0, MakeLong(X, Y));
  57.     if (ItemIndex >= 0) and (ItemIndex < Items.Count) then
  58.     begin
  59.       Hint := Items[ItemIndex];
  60.       ShowHint := True
  61.     end
  62.   end
  63. {$endif}
  64. end;
  65.  
  66. procedure TMainForm.Exit1Click(Sender: TObject);
  67. begin
  68.   Application.Terminate
  69. end;
  70.  
  71. procedure TMainForm.lstDataFieldsDblClick(Sender: TObject);
  72. const
  73.   Msg = 'FieldAddress says %s lives at $%p, $%x bytes into this object';
  74. var
  75.   S: String;
  76. begin
  77.   with Sender as TListBox do
  78.   begin
  79.     { The listbox is showing some nicely formated string. }
  80.     { Need the data field name only. }
  81.     { Can get this from the field table entry record }
  82.     S := PFieldTableEntry(Items.Objects[ItemIndex])^.Name;
  83.     MessageDlg(
  84.       Format(Msg, [S, Self.FieldAddress(S),
  85.         Longint(Self.FieldAddress(S)) - Longint(Self)]),
  86.       mtInformation, [mbOk], 0)
  87.   end
  88. end;
  89.  
  90. procedure TMainForm.lstMethodsDblClick(Sender: TObject);
  91. const
  92.   Msg = 'MethodAddress says %s lives at address $%p';
  93. var
  94.   S: String;
  95. begin
  96.   with Sender as TListBox do
  97.   begin
  98.     { The listbox is showing some nicely formated string. }
  99.     { Need the method name only. }
  100.     { Can get this from the method table entry record }
  101.     S := PMethodTableEntry(Items.Objects[ItemIndex])^.Name;
  102.     MessageDlg(
  103.       Format(Msg, [S, Self.MethodAddress(S)]),
  104.       mtInformation, [mbOk], 0)
  105.   end
  106. end;
  107.  
  108. end.
  109.